home *** CD-ROM | disk | FTP | other *** search
/ TeX 1995 July / TeX CD-ROM July 1995 (Disc 1)(Walnut Creek)(1995).ISO / web / schemeweb / sweb.c < prev   
Encoding:
C/C++ Source or Header  |  1994-07-25  |  10.8 KB  |  421 lines
  1. /* SchemeWEB -- WEB for Lisp.  John D. Ramsdell.
  2.  * Simple support for literate programming in Lisp.
  3.  */
  4.  
  5. /*     $Id: sweb.c,v 2.1 94/07/21 11:30:36 ramsdell Exp $     */
  6.  
  7. #ifndef lint
  8. static char vcid[] = "$Id: sweb.c,v 2.1 94/07/21 11:30:36 ramsdell Exp $";
  9. static char copyright[] = "Copyright 1994 by The MITRE Corporation.";
  10. #endif /* lint */
  11.  
  12. #define VERSION "2.1"
  13.  
  14. /*
  15.  * Copyright 1994 by The MITRE Corporation
  16.  *
  17.  * This program is free software; you can redistribute it and/or modify
  18.  * it under the terms of the GNU General Public License as published by
  19.  * the Free Software Foundation; either version 1, or (at your option)
  20.  * any later version.
  21.  *
  22.  * This program is distributed in the hope that it will be useful,
  23.  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  24.  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  25.  * GNU General Public License for more details.
  26.  * 
  27.  * For a copy of the GNU General Public License, write to the 
  28.  * Free Software Foundation, Inc., 675 Mass Ave, 
  29.  * Cambridge, MA 02139, USA.
  30.  */
  31.  
  32. /*
  33. This program processes SchemeWEB files.  A SchemeWEB file is a Lisp
  34. source file which contains code sections and comment sections, but
  35. each section is identified in a novel way.  A code section begins with
  36. a line whose first character is a left parenthesis.  It continues
  37. until a line is found which contains the parenthesis that matches the
  38. one which started the code section.  The remaining lines of text in
  39. the source file are treated as comments.  Several operations involving
  40. SchemeWEB files are provided by the this program.  See the manual
  41. page for a complete description of the various operations.
  42. */
  43.  
  44. /* SchemeWEB is currently set up for use with LaTeX. */
  45.  
  46. /* Define TANGLE to make a program which translates SchemeWEB source
  47. into Scheme source by default. */
  48.  
  49. /* Define SAVE_LEADING_SEMICOLON if you want text lines to be copied 
  50. with any leading semicolon while weaving. */
  51.  
  52. #include <stdio.h>
  53.  
  54. typedef enum {FALSE, TRUE} bool;
  55.  
  56. /* Runtime flags */
  57. bool weaving;            /* Weaving or tangling? */
  58. bool strip_comments;        /* Strip comments while tangling. */
  59.  
  60. /* Formatting commands added into weaved documents. */
  61. char *begin_comment = "\\mbox{"; /* This pair is used */
  62. char *end_comment = "}";    /* to surround comments in code. */
  63. char *begin_code = "\\begin{flushleft}\n"; /* This pair is used */
  64. char *end_code = "\\end{flushleft}\n"; /* to surround code. */
  65. char *code_line_separator = "\\\\ ";
  66. char *begin_code_line = "\\verb|"; /* This pair is used */
  67. char *end_code_line = "|";    /* to surround code lines. */
  68.  
  69. /* Information for error messages. */
  70. char *prog = NULL;        /* Name of program. */
  71. char *src = NULL;        /* Name of input file. */
  72. int lineno = 1;            /* Line number. */
  73.  
  74. /* Output occurs through putchar, putstring, and code_putchar. */
  75.  
  76. #define putstring(s) (fputs(s, stdout))
  77.  
  78. int                /* Used while printing */
  79. code_putchar(c)            /* a code section. */
  80.      int c;
  81. {
  82.   if (c == '|' && weaving) return putstring("|\\verb-|-\\verb|");
  83.   else return putchar(c);
  84. }
  85.  
  86. /* All input occurs in the following routines so that TAB characters
  87. can be expanded while weaving. TeX treats TAB characters as a
  88. space--not what is wanted. */
  89.  
  90. int ch_buf;            /* Used to implement */
  91. bool buf_used = FALSE;        /* one character push back. */
  92.  
  93. int 
  94. getchr()
  95. {
  96.   int c;
  97.   static int spaces = 0;    /* Spaces left to print a TAB. */
  98.   static int column = 0;    /* Current input column. */
  99.   if (buf_used) {
  100.     buf_used = FALSE;
  101.     return ch_buf;
  102.   }
  103.   if (spaces > 0) {
  104.     spaces--;
  105.     return ' ';
  106.   }
  107.   switch (c = getc(stdin)) {
  108.   case '\t':
  109.     if (!weaving) return c;
  110.     spaces = 7 - (7&column);    /* Maybe this should be 7&(~column). */
  111.     column += spaces + 1;
  112.     return ' ';
  113.   case '\n':
  114.     lineno++;
  115.     column = 0;
  116.     return c;
  117.   default:
  118.     column++;
  119.     return c;
  120.   }
  121. }
  122.  
  123. void 
  124. ungetchr(c)
  125.      int c;
  126. {
  127.   buf_used = TRUE;
  128.   ch_buf = c;
  129. }
  130.  
  131. /* Error message for end of file found in code. */
  132. bool 
  133. report_eof_in_code()
  134. {
  135.   fprintf(stderr, "End of file within a code section.\n");
  136.   return TRUE;
  137. }
  138.  
  139. bool 
  140. copy_text_saw_eof()        /* Copies a line of text out. */
  141. {                /* Used while printing */
  142.   int c;            /* a text section. */
  143.   while (1) {
  144.     c = getchr();
  145.     if (c == EOF) return TRUE;
  146.     if (c == '\n') return FALSE;
  147.     putchar(c);
  148.   }
  149. }
  150.  
  151. bool 
  152. strip_text_saw_eof()        /* Gobbles up a line of input. */
  153. {
  154.   int c;
  155.   while (1) {
  156.     c = getchr();
  157.     if (c == EOF) return TRUE;
  158.     if (c == '\n') return FALSE;
  159.   }
  160. }
  161.  
  162. bool                /* This copies comments */
  163. copy_comment_saw_eof()        /* within code sections. */
  164. {                
  165.   if (weaving) putstring(begin_comment);
  166.   putchar(';');
  167.   if (copy_text_saw_eof()) return TRUE;
  168.   if (weaving) putstring(end_comment);
  169.   return FALSE;
  170. }
  171.  
  172. bool                /* Copies a string found */
  173. copy_string_saw_eof()        /* within a code section. */
  174. {
  175.   int c;
  176.   while (1) {
  177.     c = getchr();
  178.     if (c == EOF) return TRUE;
  179.     if (c == '\n') {        /* Found a string which continues on */
  180.       putstring(end_code_line);    /* a new line. */
  181.       putchar(c);        /* Close existing line, and then */
  182.       putstring(code_line_separator); /* begin copying the rest of */
  183.       putstring(begin_code_line); /* on the next line. */
  184.       continue;
  185.     }
  186.     code_putchar(c);
  187.     switch (c) {
  188.     case '"': return FALSE;
  189.     case '\\':
  190.       c = getchr();
  191.       if (c == EOF) return TRUE;
  192.       code_putchar(c);
  193.     }
  194.   }
  195. }
  196.  
  197. bool 
  198. maybe_char_syntax_saw_eof()
  199. {                /* Makes sure that the character */
  200.   int c;            /* #\( does not get counted in */
  201.   c = getchr();            /* balancing parentheses. */
  202.   if (c == EOF) return TRUE;
  203.   if (c != '\\') {
  204.     ungetchr(c);
  205.     return FALSE;
  206.   }
  207.   code_putchar(c);
  208.   c = getchr();
  209.   if (c == EOF) return TRUE;
  210.   code_putchar(c);
  211.   return FALSE;
  212. }
  213.  
  214. bool                /* Copies a code section */
  215. copy_code_failed()        /* containing S-exprs. */
  216. {
  217.   int parens = 1;        /* Used to balance parentheses. */
  218.   int c;
  219.   while (1) {            /* While parens are not balanced, */
  220.     c = getchr();
  221.     if (c == EOF)        /* Report failure on EOF. */
  222.       return report_eof_in_code();
  223.     if (c == '\n' && weaving)
  224.       putstring(end_code_line);
  225.     if (c == ';') {         /* Report failure on EOF in a comment. */
  226.       if (weaving) putstring(end_code_line);
  227.       if (strip_comments
  228.       ? strip_text_saw_eof()
  229.       : copy_comment_saw_eof())
  230.     return report_eof_in_code();
  231.       else
  232.     c = '\n';
  233.     }
  234.     code_putchar(c);        /* Write the character and then see */
  235.     switch (c) {        /* if it requires special handling. */
  236.     case '(':
  237.       parens++;
  238.       break;
  239.     case ')':
  240.       parens--;            
  241.       if (parens < 0) {
  242.     fprintf(stderr, "Too many right parentheses found.\n");
  243.     return TRUE;
  244.       }
  245.       break;
  246.     case '"':            /* Report failure on EOF in a string. */
  247.       if (copy_string_saw_eof()) {
  248.     fprintf(stderr, "End of file found within a string.\n");
  249.     return TRUE;
  250.       }
  251.       break;
  252.     case '#':            /* Report failure on EOF in a character. */
  253.       if (maybe_char_syntax_saw_eof())
  254.     return report_eof_in_code();
  255.       break;
  256.     case '\n':
  257.       if (parens == 0) return FALSE;
  258.       if (weaving) {
  259.     putstring(code_line_separator);
  260.     putstring(begin_code_line);
  261.       }
  262.     }
  263.   }
  264. }
  265.  
  266. int 
  267. schemeweb()
  268. {
  269.   int c;
  270.   while (1) {            /* At loop start it's in text mode */
  271.     c = getchr();        /* and at the begining of a line. */
  272.     if (c == '(') {        /* text mode changed to code mode. */
  273.       if (weaving) putstring(begin_code);
  274.       do {            /* Copy code. */
  275.     if (weaving) putstring(begin_code_line);
  276.     putchar(c);
  277.     if (copy_code_failed()) {
  278.       fputs(prog, stderr);
  279.       if (src != NULL)
  280.         fprintf(stderr, ":%s:", src);
  281.       else
  282.         fputs(":<stdin>:", stderr);
  283.       fprintf(stderr,
  284.           "%d: Error in a code section.\n",
  285.           lineno);
  286.       return 1;
  287.     }
  288.     c = getchr();        /* Repeat when there is code */
  289.       } while (c == '(');    /* immediately after some code. */
  290.       if (weaving) putstring(end_code);
  291.     }
  292.     /* Found a text line--now in text mode. */
  293. #if !defined SAVE_LEADING_SEMICOLON
  294.     if (c == ';' && weaving)
  295.       c = getchr();
  296. #endif
  297.     if (c == EOF) return 0;    /* Files that do not end with */
  298.     ungetchr(c);        /* a newline are okay. */
  299.  
  300.     if (strip_comments) {
  301.       if (strip_text_saw_eof()) return 0;
  302.     }
  303.     else {
  304.       if (c != '\n' && !weaving) putchar(';');
  305.       if (copy_text_saw_eof()) return 0; /* Copy a text line. */
  306.       putchar('\n');
  307.     }
  308.   }
  309. }
  310.  
  311. int                /* Removes any semicolons */
  312. untangle()            /* than start a line of text. */
  313. {
  314.   int c;
  315.   
  316.   while (1) {            /* At a beginning of a line of text */
  317.     c = getchar();        /* when at this point in the code. */
  318.     if (c == EOF) return 0;
  319.     if (c != ';') putchar(c);
  320.     while (c != '\n') {
  321.       c = getchar();
  322.       if (c == EOF) return 0;
  323.       putchar(c);
  324.     }
  325.   }
  326. }
  327.  
  328. bool                /* Open the file arguments */
  329. open_file_args_failed(argc, argv)
  330.      int argc;
  331.      char *argv[];
  332. {
  333.   switch (argc) {
  334.   case 2:
  335.   case 1:
  336.     src = argv[0];        /* Save for error messages. */
  337.     if (NULL == freopen(argv[0], "r", stdin)) {
  338.       fprintf(stderr, "Cannot open %s for reading.\n", argv[0]);
  339.       break;
  340.     }
  341.     if (argc == 2 && NULL == freopen(argv[1], "w", stdout)) {
  342.       fprintf(stderr, "Cannot open %s for writing.\n", argv[1]);
  343.       break;
  344.     }
  345.   case 0:
  346.     return FALSE;
  347.   }
  348.   return TRUE;
  349. }
  350.  
  351. int 
  352. usage()
  353. {
  354.   fprintf(stderr, 
  355.       "Usage: %s [-stuvwx] [input_file [output_file]]\n%s%s%s%s%s%s",
  356.       prog,
  357.       "\t-s:  tangle input stripping comments\n",
  358.       "\t-t:  tangle input retaining comments\n",
  359.       "\t-u:  untangle input\n",
  360.       "\t-v:  print version information\n",
  361.       "\t-w:  weave input\n",
  362.       "\t-x:  weave input and exclude line breaks in code sections\n");
  363.   fprintf(stderr, "The default option is %s.\n",
  364. #if defined TANGLE
  365.       "-t"
  366. #else
  367.       "-w"
  368. #endif
  369.       );
  370.   return 1;
  371. }
  372.  
  373. int 
  374. main (argc, argv)
  375.      int argc;
  376.      char *argv[];
  377. {
  378.   bool untangling = FALSE;
  379. #if defined TANGLE
  380.   weaving = FALSE;
  381. #else
  382.   weaving = TRUE;
  383. #endif
  384.   strip_comments = FALSE;
  385.  
  386.   prog = argv[0];        /* Save program name for error messages. */
  387.  
  388.   /* Option processing.  Note only one option can be requested at a time. */
  389.   /* -s: tangle input stripping comments. */
  390.   /* -t: tangle input retaining comments. */
  391.   /* -u: untangle input. */
  392.   /* -v: print version information. */
  393.   /* -w: weave input. */
  394.   /* -x: weave input and exclude line breaks in code sections. */
  395.   if (argc > 1 && argv[1][0] == '-') {
  396.     switch (argv[1][1]) {
  397.     case 's': weaving = FALSE; strip_comments = TRUE; break;
  398.     case 't': weaving = FALSE; break;
  399.     case 'u': untangling = TRUE; break;
  400.     case 'v':
  401.       fprintf(stderr, "This is SchemeWEB version %s.\n", VERSION);
  402.       return 0;
  403.     case 'w': weaving = TRUE; break;
  404.     case 'x': weaving = TRUE; code_line_separator = "\\\\* "; break;
  405.     default:
  406.       fprintf(stderr, "Bad option: -%c.\n", argv[1][1]);
  407.       return usage();
  408.     }
  409.     if (argv[1][2] != '\0') {
  410.       fprintf(stderr, "Only one option allowed.\n");
  411.       return usage();
  412.     }
  413.     argc--; argv++;
  414.   }
  415.  
  416.   if (open_file_args_failed(argc - 1, argv + 1)) return usage();
  417.  
  418.   if (untangling) return untangle();
  419.   return schemeweb();
  420. }
  421.